home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Delphi Programmer's Power Pack
/
Delphi Volume 1.iso
/
e_to_l
/
isamexpt
/
wntisam4.pas
< prev
Wrap
Pascal/Delphi Source File
|
1996-09-15
|
83KB
|
1,958 lines
{HISTORY of Changes:
********* VERSION 1.04 *********
18.01.1996 Property NAME of ISAMBROWSER changed form ISAMBROWSER1 to RECORDNAME+BROWSER1
20.01.1996 Length of DBASE-FIELDNAMES = 8, search for fieldnames that already exist
}
unit Wntisam4;
interface
Uses Classes, DB;
{$I DEFINE.PAS}
function Erzeuge_BrowserSource(const UnitIdent, FormIdent,
EditUnitIdent,EditFormIdent: String;
alsMainform: Boolean;
RecList,KeyList,IIDList: TStringList;
DBase_Export,DBase_Import: Boolean;
StruFileName: String;
Sprache: Integer;
CreaBttn, SetupBttnCheck: Boolean;
TypDateiName, AliasName: String): TMemoryStream;
function Erzeuge_EditorSource(const UnitIdent, FormIdent: string;
RecList,KeyList: TStringList;
Sprache: Integer;
TypDateiName: String): TMemoryStream;
Function GetFieldTypEditor(S: String;
var FieldName: String;
var FieldDataType: TFieldType;
var Len: Integer;
var Arr1,Arr2: Integer;
var Decimals: Integer): Byte;
procedure FmtWrite(Stream: TStream; Fmt: PChar;
const Args: array of const);
implementation
Uses SysUtils, UToolDll, Wnt_Base;
procedure FmtWrite(Stream: TStream; Fmt: PChar;
const Args: array of const);
begin
if (Stream <> nil) and (SourceBuffer <> nil) then
begin
StrLFmt(SourceBuffer, SourceBufferSize, Fmt, Args);
Stream.Write(SourceBuffer[0], StrLen(SourceBuffer));
end;
end;
Function GetBrowserString(NStr,FormIdent: String; Arr: Integer;
var JChar: String): String;
var S,FeldName,AStr: String;
begin
S:= '';
JChar:= '|^';
FeldName:= Copy(NStr,1,Pos(':',NStr)-1);
Strip(FeldName);
if Arr > 0 then begin
Str(Arr,AStr);
FeldName:= FeldName+'['+AStr+']';
end;
if (Length(FeldName) > 0) and (Pos('DUMMY',NStr) = 0)
and (Pos('MEMO',NStr) = 0) and (Pos('IGNORE',NStr) = 0) then begin
if Pos('WORD',NStr) > 0 then begin
if (Pos('DATUM',NStr) > 0) or (Pos('DATE',NStr) > 0) then begin
S:= 'DateStr('+FeldName+')';
end
else begin
S:= 'DelSpace(IntStr('+FeldName+'))';
JChar:= '░^';
end;
end
else if Pos('INTEGER',NStr) > 0 then begin
S:= 'DelSpace(IntStr('+FeldName+'))';
JChar:= '░^';
end
else if Pos('BYTE',NStr) > 0 then begin
S:= 'DelSpace(IntStr('+FeldName+'))';
JChar:= '░^';
end
else if Pos('LONGINT',NStr) > 0 then begin
if (Pos('DATUM',NStr) > 0) or (Pos('DATE',NStr) > 0) then begin
S:= 'DateStr('+FeldName+')';
end
else begin
S:= 'DelSpace(IntStr('+FeldName+'))';
JChar:= '░^';
end;
end
else if Pos('REAL',NStr) > 0 then begin
S:= 's:= DelSpace(SimpleFormDezStr('+FeldName+',12,2))';
JChar:= '░^';
end
else if (Pos('CHAR',NStr) > 0) and (Pos('ARRAY',NStr) = 0) then begin
S:= FeldName;
end
else if (Pos('BOOLEAN',NStr) > 0) then begin
S:= 'BoolStr('+FeldName+')';
end
else S:= 'String_oem2ansi(Table.AnsiConvert,'+FeldName+')'
end;
GetBrowserString:= S;
end;
Function GetFieldTypEditor(S: String;
var FieldName: String;
var FieldDataType: TFieldType;
var Len: Integer;
var Arr1,Arr2: Integer;
var Decimals: Integer): Byte;
var G: Byte;
x,Code,A1,A2,xPos: Integer;
SStr,AStr,A1Str,NStr: String;
begin
Arr1:= 1;
Arr2:= 1;
Decimals:= 0;
SStr:= UpperCase(S);
AStr:= SStr;
if (Pos('ARRAY[',AStr) > 0) and (Pos('CHAR',Astr) = 0) then begin
Delete(AStr,1,Pos('ARRAY[',AStr)+5);
if Pos(']',AStr) > 0 then begin
AStr:= Copy(AStr,1,Pos(']',AStr)-1);
if Pos('.',AStr) > 0 then begin
A1Str:= Copy(AStr,1,Pos('.',AStr)-1);
While (Pos('.',AStr) > 0) do Delete(AStr,1,Pos('.',AStr));
Strip(a1Str); Strip(AStr);
Val(A1Str,A1,Code);
Val(AStr,A2,Code);
if (A1 > 0) and (A2 > 0) then begin
Arr1:= A1;
Arr2:= A2;
if Arr1 > Arr2 then begin
A1:= Arr2;
Arr2:= Arr1;
Arr1:= A1;
end;
end;
end;
end;
end;
if (Pos('DATUM',SStr) > 0) or (Pos('DATE',SStr) > 0) then begin
G:= 1;
FieldDataType:= ftDate;
Len:= 10;
end
else if (Pos('REAL',SStr) > 0) or (Pos('INTEGER',SStr) > 0)
or (Pos('BYTE',SStr) > 0) or (Pos('WORD',SStr) > 0)
or (Pos('LONGINT',SStr) > 0) then begin
G:= 2;
if Pos('REAL',SStr) > 0 then begin
FieldDataType:= ftFLOAT;
Len:= 10;
Decimals:= 2;
NStr:= SStr;
Strip(NStr);
xPos:= Pos('{NACHK',NStr);
if xPos > 0 then begin
Delete(NStr,1,Pos('{NACHK',NStr)+5);
if Pos('OMMASTELLEN',NStr) > 0 then Delete(NStr,Pos('OMMASTELLEN',NStr),11);
if Pos('=',NStr) > 0 then Delete(NStr,Pos('=',NStr),1);
xPos:= Pos('}',NStr);
if xPos > 0 then begin
NStr:= Copy(NStr,1,xPos-1);
Strip(NStr);
Val(NStr,x,Code);
if x > 0 then Decimals:= x;
end;
end
else begin
xPos:= Pos('{DECIMALS=',NStr);
if xPos > 0 then begin
Delete(NStr,1,Pos('{DECIMALS=',NStr)+9);
xPos:= Pos('}',NStr);
if xPos > 0 then begin
NStr:= Copy(NStr,1,xPos-1);
Strip(NStr);
Val(NStr,x,Code);
if x > 0 then Decimals:= x;
end;
end;
end;
end
else if Pos('INTEGER',SStr) > 0 then begin
FieldDataType:= ftSMALLINT;
Len:= 8;
end
else if Pos('BYTE',SStr) > 0 then begin
FieldDataType:= ftSMALLINT;
Len:= 4;
end
else if Pos('WORD',SStr) > 0 then begin
FieldDataType:= ftWORD;
Len:= 8;
end
else begin
FieldDataType:= ftINTEGER;
Len:= 12;
end;
end
else if (Pos('MEMO',SStr) > 0) then begin
G:= 3;
FieldDataType:= ftMEMO;
Len:= 255;
end
else if (Pos('BOOLEAN',SStr) > 0) then begin
G:= 4;
FieldDataType:= ftBOOLEAN;
Len:= 2;
end
else begin
G:= 0;
FieldDataType:= ftString;
Strip(SStr);
Len:= 255;
if Pos('ARRAY[',SStr) > 0 then begin
Delete(SStr,1,Pos(']',SStr));
if SStr[1] = ']' then Delete(SStr,1,1);
end
else if Pos('CHAR',SStr) > 0 then Len:= 1;
if Pos('[',SStr) > 0 then begin
Delete(SStr,1,Pos('[',SStr));
if Pos(']',SStr) > 0 then begin
SStr:= Copy(SStr,1,Pos(']',SStr)-1);
Val(SStr,Len,Code);
end;
end;
end;
Strip(S);
FieldName:= Copy(S,1,Pos(':',S)-1);
Strip(FieldName);
GetFieldTypEditor:= G;
end;
Procedure GetArray(AStr: String; var Arr1,Arr2: Integer);
var A1Str: String;
A1,A2,Code: Integer;
begin
Arr1:= 1;
Arr2:= 1;
if (Pos('ARRAY[',AStr) > 0) and (Pos('CHAR',Astr) = 0) then begin
Delete(AStr,1,Pos('ARRAY[',AStr)+5);
if Pos(']',AStr) > 0 then begin
AStr:= Copy(AStr,1,Pos(']',AStr)-1);
if Pos('.',AStr) > 0 then begin
A1Str:= Copy(AStr,1,Pos('.',AStr)-1);
While (Pos('.',AStr) > 0) do Delete(AStr,1,Pos('.',AStr));
Strip(a1Str); Strip(AStr);
Val(A1Str,A1,Code);
Val(AStr,A2,Code);
if (A1 > 0) and (A2 > 0) then begin
Arr1:= A1;
Arr2:= A2;
if Arr1 > Arr2 then begin
A1:= Arr2;
Arr2:= Arr1;
Arr1:= A1;
end;
end;
end;
end;
end;
end;
function Erzeuge_BrowserSource(const UnitIdent, FormIdent,
EditUnitIdent,EditFormIdent: String;
alsMainform: Boolean;
RecList,KeyList,IIDList: TStringList;
DBase_Export,DBase_Import: Boolean;
StruFileName: String;
Sprache: Integer;
CreaBttn, SetupBttnCheck: Boolean;
TypDateiName,AliasName: String): TMemoryStream;
const
CRLF = #13#10;
Var Decimals,Len,fnx,I,x,k,arr1,arr2,a,Feld: integer;
G: Byte;
BStr,SStr,RStr,xStr,NStr,DbFldNam : String;
ArrName,Zeichen,RecordName,FldNam,FeldName: String;
DBFeldList: TStringList;
JustChar,MemoName: String;
FieldDataType: TFieldType;
begin
SourceBuffer := StrAlloc(SourceBufferSize);
try
Result := TMemoryStream.Create;
try
DBFeldList:= TStringList.Create;
{ unit header and uses clause }
FmtWrite(Result,
'unit %s;' + CRLF + CRLF +
'interface' + CRLF + CRLF +
'uses WinTypes, WinProcs, Classes, Graphics, Forms, Controls, Menus,'+CRLF,[UnitIdent]);
FmtWrite(Result,
' Dialogs, StdCtrls, Buttons, ExtCtrls,'+CRLF+
' IsamTabl, FvcBrows, LowBrows, IsamBrow, IsamNav,'+CRLF+
' Filer, DbTables, UUseisam;'+CRLF+CRLF,[NIL]);
RecordName:= '';
MemoName:= '';
FmtWrite(Result,'{$I %s}'+CRLF+CRLF,[TypDateiName]);
if RecList.Count > 0 then begin
For x:= 0 to RecList.Count-1 do begin
RStr:= RecList[x];
{FmtWrite(Result,'%s'+CRLF,[RStr]);}
RStr:= UpperCase(RStr);
Strip(RStr);
if Pos('=RECORD',RStr) > 0 then begin
RStr:= Copy(RStr,1,Pos('=RECORD',RStr)-1);
Strip(RStr);
RecordName:= RStr;
end;
if (Pos(':',RStr) > 0) and (Pos('DUMMY',UpperCase(RStr)) = 0)
and (Pos('IGNORE',Uppercase(RStr)) = 0) then begin
G:= GetFieldTypEditor(RStr,FeldName,FieldDataType,Len,Arr1,Arr2,Decimals);
if G = 3 then MemoName:= FeldName;
end;
end;
end;
FmtWrite(Result,
'type'#13#10 +
' T%s = class(TForm)'+CRLF,[FormIdent]);
FmtWrite(Result,
' StatusBar : TPanel;' +CRLF+
' Panel1 : TPanel;' +CRLF+
' Panel2 : TPanel;' + CRLF,[NIL]);
FmtWrite(Result,
' KeyPanel : TPanel;' + CRLF +
' ZeitPanel : TPanel;'+ CRLF,[NIL]);
FmtWrite(Result,
' %sTimer : TTimer;'+ CRLF +
' Header1 : THeader;'+CRLF+
' %sTable : TIsamTable;'+CRLF,[FormIdent,FormIdent]);
FmtWrite(Result,
' NeuBttn : TSpeedButton;' +CRLF+
' EditBttn : TSpeedButton;'+CRLF+
' SuchBttn : TSpeedButton;' +CRLF,[NIL]);
FmtWrite(Result,
' KeyBttn : TSpeedButton;' +CRLF+
' LoeschBttn : TSpeedButton;'+CRLF+
' ReorgBttn : TSpeedButton;'+CRLF,[NIL]);
FmtWrite(Result,
' BrwBttn : TSpeedButton;'+CRLF,[NIL]);
if DBASE_Export then begin
FmtWrite(Result,
' DbExpBttn : TSpeedButton;'+CRLF,[NIL]);
end;
if DBASE_Import then begin
FmtWrite(Result,
' DbImpBttn : TSpeedButton;'+CRLF,[NIL]);
end;
if CreaBttn then begin
FmtWrite(Result,
' CreateBttn : TSpeedButton;'+CRLF,[NIL]);
end;
if SetupBttnCheck then begin
FmtWrite(Result,
' SetupBttn : TSpeedButton;'+CRLF,[NIL]);
end;
FmtWrite(Result,
' ExitBttn : TSpeedButton;'+CRLF,[NIL]);
FmtWrite(Result,
' %sBrowser1: TIsamBrowser;'+CRLF+
' IsamNavigator1: TIsamNavigator;'+CRLF,[RecordName]);
FmtWrite(Result,
' procedure ShowHint(Sender: TObject);' +CRLF+
' procedure FormCreate(Sender: TObject);' +CRLF+
' Procedure FormResize(Sender: TObject);' +CRLF,[NIL]);
FmtWrite(Result,
' Procedure FormShow(Sender: TObject);' + CRLF+
' Procedure Header1Sized(Sender: TObject; ASection, AWidth: Integer);' + CRLF +
' Function %sBrowser1BuildRow(Sender: TObject; var RR: RowRec): Integer;' + CRLF,[RecordName]);
FmtWrite(Result,
' procedure ExitBttnClick(Sender: TObject);'+CRLF+
' procedure FormDestroy(Sender: TObject);' +CRLF,[NIL]);
FmtWrite(Result,
' procedure EditBttnClick(Sender: TObject);'+CRLF+
' procedure NeuBttnClick(Sender: TObject);' +CRLF+
' procedure SuchBttnClick(Sender: TObject);' +CRLF,[NIL]);
FmtWrite(Result,
' procedure KEYBttnClick(Sender: TObject);' +CRLF+
' procedure LoeschBttnClick(Sender: TObject);' + CRLF+
' Procedure %sTimerTimer(Sender: TObject);' + CRLF,[FormIdent]);
FmtWrite(Result,
' Procedure ReorgBttnClick(Sender: TObject);' + CRLF+
' Procedure BrwBttnClick(Sender: TObject);' + CRLF,[NIL]);
if DBASE_Export then begin
FmtWrite(Result,
' Procedure DBExpBttnClick(Sender: TObject);'+CRLF,[NIL]);
end;
if DBASE_Import then begin
FmtWrite(Result,
' Procedure DBImpBttnClick(Sender: TObject);'+CRLF,[NIL]);
end;
if CreaBttn then begin
FmtWrite(Result,
' Procedure CreateBttnClick(Sender: TObject);'+CRLF,[NIL]);
end;
if SetupBttnCheck then begin
FmtWrite(Result,
' Procedure SetupBttnClick(Sender: TObject);'+CRLF,[NIL]);
end;
FmtWrite(Result,
' Private'+CRLF+
' KeyListe: TStringList;'+CRLF+
' Procedure Set_Language;'+CRLF,[NIL]);
FmtWrite(Result,
' public' +CRLF+
' %sData: %s;'+CRLF+
' %sDup : %s;'+CRLF+
'end;'+CRLF+CRLF,[RecordName,RecordName,RecordName,RecordName]);
FmtWrite(Result,
'Function %sKeyProc(Var Daten; KeyNr:Word): IsamKeyStr; FAR;'+CRLF+CRLF,[RecordName]);
if DBASE_Export then begin
FmtWrite(Result,
'Procedure %sDbaseExportProc(var DATA; DBTable: TTable; ISTable: TIsamTable); far;'+CRLF,[RecordName]);
end;
FmtWrite(Result,
'var' + CRLF +
' %s: T%s;' + CRLF + CRLF +
'implementation' + CRLF + CRLF,[FormIdent,FormIdent]);
if (DBase_Export = False) and (DBase_Import = False) then
FmtWrite(Result,
'uses SysUtils, UToolDll, Isam_Key, IsamSuch, %s, Dat;'+CRLF,[EditUnitIdent])
else begin
FmtWrite(Result,
'uses SysUtils, UToolDll, Isam_Key, IsamSuch,'+CRLF+
'%s, Isam2Dbf, Dbf2Isam, %s, Dat;'+CRLF,[EditUnitIdent,StruFileName])
end;
FmtWrite(Result,
'{$R *.DFM}' + CRLF + CRLF, [EditUnitIdent]);
FmtWrite(Result,
'Function %sGetFeldProc(Feld: Integer; Table: TIsamTable; var DATA): String; far;'+CRLF+
'var S: String;'+CRLF+
'begin'+CRLF,[RecordName]);
FmtWrite(Result,
' S:= '+Chr(39)+Chr(39)+';'+CRLF+
' With %s(Data) do begin'+CRLF+
' Case Feld of'+CRLF,[RecordName]);
if RecList.Count > 0 then begin
Feld:= 0;
For x:= 0 to RecList.Count-1 do begin
NStr:= RecList[x];
NStr:= Uppercase(NStr);
Strip(NStr);
if (Pos(':',NStr) > 0) then begin
GetArray(NStr,Arr1,Arr2);
if Arr1 = Arr2 then begin
A:= 0;
JustChar:= '|^';
BStr:= GetBrowserString(NStr,FormIdent,A,JustChar);
if BStr <> '' then begin
Inc(Feld);
if Pos('REAL',NStr) > 0 then begin
JustChar := '░^';
FmtWrite(Result,' %s: %s+'+Chr(39)+'%s'+Chr(39)+';'+CRLF,[DezStr(Feld),BStr,JustChar]);
end
else
FmtWrite(Result,' %s: s:= %s+'+Chr(39)+'%s'+Chr(39)+';'+CRLF,[DezStr(Feld),BStr,JustChar]);
end;
end
else begin
For a:= arr1 to Arr2 do begin
BStr:= GetBrowserString(NStr,FormIdent,A,JustChar);
JustChar:= '|^';
if BStr <> '' then begin
Inc(Feld);
if Pos('REAL',NStr) > 0 then begin
JustChar := '░^';
FmtWrite(Result,' %s: %s+'+Chr(39)+'%s'+Chr(39)+';'+CRLF,[DezStr(Feld),BStr,JustChar]);
end
else
FmtWrite(Result,' %s: s:= %s+'+Chr(39)+'%s'+Chr(39)+';'+CRLF,[DezStr(Feld),BStr,JustChar]);
end;
end;
end;
end;
end;
end;
FmtWrite(Result,
' end;'+CRLF+
' end;'+CRLF+
' Result:= S;'+CRLF+
'end;'+CRLF+CRLF,[NIL]);
if DBASE_Export then begin
DBFeldList.Clear;
FmtWrite(Result,
'Procedure %sDbaseExportProc(var DATA; DBTable: TTable; ISTable: TIsamTable); '+CRLF,[RecordName]);
if MemoName <> '' then FmtWrite(Result,
'var M: TMemo;'+CRLF+
' MStr: Array[0..Sizeof(%sData.%s)+1] of Char;'+CRLF,[RecordName,MemoName]);
FmtWrite(Result,
'begin'+CRLF+
' With %s(Data) do begin'+CRLF,[RecordName]);
if RecList.Count > 0 then begin
For X:= 0 to RecList.Count-1 do begin
RStr:= RecList[x];
RStr:= UpperCase(RStr);
Strip(RStr);
if (Pos(':',RStr) > 0) and (Pos('DUMMY',RStr) = 0) then begin
GetArray(RStr,Arr1,Arr2);
FldNam:= Copy(RStr,1,Pos(':',RStr)-1);
Strip(FldNam);
DBFldNam:= FldNam;
if Length(DBFldNam) > 8 then DBFldNam:= Copy(DBFldNam,1,8);
FeldName:= DBFldNam;
ArrName:= FldNam;
For a:= Arr1 to Arr2 do begin
if Arr1 <> Arr2 then begin
FeldName:= Copy(DbFldNam,1,6) + DezStr(a);
ArrName:= FldNam + '['+DezStr(a)+']';
end;
if DBFeldList.Indexof(FeldName) > -1 then begin
fnx:= 1;
Repeat
inc(fnx);
FeldName:= Copy(DBFldNam,1,6)+DezStr(fnx);
Until DBFeldList.Indexof(FeldName) = -1;
end;
DBFeldList.Add(FeldName);
Zeichen:= Chr(39);
if Pos('WORD',RStr) > 0 then begin
if (Pos('DATUM',RStr) > 0) or (Pos('DATE',RStr) > 0) then begin
FmtWrite(Result,
' DBTable.FieldByName(%s%s%s).AsString:= DateStr(%s);'+CRLF,
[Zeichen,FeldName,Zeichen,ArrName]);
end
else begin
FmtWrite(Result,
' DBTable.FieldByName(%s%s%s).AsInteger:= %s;'+CRLF,
[Zeichen,FeldName,Zeichen,ArrName]);
end;
end
else if Pos('INTEGER',RStr) > 0 then begin
FmtWrite(Result,
' DBTable.FieldByName(%s%s%s).AsInteger:= %s;'+CRLF,
[Zeichen,FeldName,Zeichen,ArrName]);
end
else if Pos('BYTE',RStr) > 0 then begin
FmtWrite(Result,
' DBTable.FieldByName(%s%s%s).AsInteger:= %s;'+CRLF,
[Zeichen,FeldName,Zeichen,ArrName]);
end
else if Pos('LONGINT',RStr) > 0 then begin
if (Pos('DATUM',RStr) > 0) or (Pos('DATE',RStr) > 0) then begin
FmtWrite(Result,
' DBTable.FieldByName(%s%s%s).AsString:= DateStr(%s);'+CRLF,
[Zeichen,FeldName,Zeichen,ArrName]);
end
else begin
FmtWrite(Result,
' DBTable.FieldByName(%s%s%s).AsInteger:= %s;'+CRLF,
[Zeichen,FeldName,Zeichen,ArrName]);
end
end
else if Pos('REAL',RStr) > 0 then begin
FmtWrite(Result,
' DBTable.FieldByName(%s%s%s).AsFloat:= %s;'+CRLF,
[Zeichen,FeldName,Zeichen,ArrName]);
end
else if Pos('BOOLEAN',RStr) > 0 then begin
FmtWrite(Result,
' DBTable.FieldByName(%s%s%s).AsBoolean:= %s;'+CRLF,
[Zeichen,FeldName,Zeichen,ArrName]);
end
else if Pos('MEMO',RStr) > 0 then begin
FmtWrite(Result,
' M:= TMemo.Create(Application);'+CRLF+
' Move(%s,MStr,Sizeof(%s));'+CRLF+
' M.SetTextBuf(MStr);'+CRLF,[ArrName,ArrName]);
FmtWrite(Result,
' TMemoField(DBTable.FieldByName(%s%s%s)).Assign(M.Lines);'+CRLF+
' M.Free;'+CRLF,
[Zeichen,FeldName,Zeichen]);
end
else begin
FmtWrite(Result,
' DBTable.FieldByName(%s%s%s).AsString:= String_oem2ansi(ISTable.AnsiConvert,%s);'+CRLF,
[Zeichen,FeldName,Zeichen,ArrName]);
end;
end;
end;
end;
end;
FmtWrite(Result,
' end;'+CRLF+
'end;'+CRLF+CRLF,[NIL]);
end;
if DBASE_Import then begin
DBFeldList.Clear;
FmtWrite(Result,
'Procedure %sDbaseImportProc(var DATA; DBTable: TTable; ISTable: TIsamTable); far;'+CRLF,[RecordName]);
if MemoName <> '' then FmtWrite(Result,
'var M: TMemo;'+CRLF+
' MStr: Array[0..Sizeof(%sDATA.%s)+1] of Char;'+CRLF,[RecordName,MemoName]);
FmtWrite(Result,
'begin'+CRLF+
' Fillchar(%s(DATA),Sizeof(%s),#0);'+CRLF+
' With %s(Data) do begin'+CRLF,[RecordName,RecordName,RecordName]);
if RecList.Count > 0 then begin
For X:= 0 to RecList.Count-1 do begin
RStr:= RecList[x];
RStr:= UpperCase(RStr);
Strip(RStr);
if (Pos(':',RStr) > 0) and (Pos('DUMMY',RStr) = 0) then begin
GetArray(RStr,Arr1,Arr2);
FldNam:= Copy(RStr,1,Pos(':',RStr)-1);
Strip(FldNam);
DBFldNam:= FldNam;
if Length(DBFldNam) > 8 then DBFldNam:= Copy(DBFldNam,1,8);
FeldName:= DBFldNam;
ArrName:= FldNam;
For a:= Arr1 to Arr2 do begin
if Arr1 <> Arr2 then begin
FeldName:= Copy(DbFldNam,1,6) + DezStr(a);
ArrName:= FldNam + '[' + DezStr(a) + ']';
end;
if DBFeldList.Indexof(FeldName) > -1 then begin
fnx:= 1;
Repeat
inc(fnx);
FeldName:= Copy(DBFldNam,1,6)+DezStr(fnx);
Until DBFeldList.Indexof(FeldName) = -1;
end;
DBFeldList.Add(FeldName);
Zeichen:= Chr(39);
if Pos('WORD',RStr) > 0 then begin
if (Pos('DATUM',RStr) > 0) or (Pos('DATE',RStr) > 0) then begin
FmtWrite(Result,
' %s:= StrDate(DBTable.FieldByName(%s%s%s).AsString);'+CRLF,
[ArrName,Zeichen,FeldName,Zeichen]);
end
else begin
FmtWrite(Result,
' %s:= DBTable.FieldByName(%s%s%s).AsInteger;'+CRLF,
[ArrName,Zeichen,FeldName,Zeichen]);
end;
end
else if Pos('INTEGER',RStr) > 0 then begin
FmtWrite(Result,
' %s:= DBTable.FieldByName(%s%s%s).AsInteger;'+CRLF,
[ArrName,Zeichen,FeldName,Zeichen]);
end
else if Pos('BYTE',RStr) > 0 then begin
FmtWrite(Result,
' %s:= DBTable.FieldByName(%s%s%s).AsInteger;'+CRLF,
[ArrName,Zeichen,FeldName,Zeichen]);
end
else if Pos('LONGINT',RStr) > 0 then begin
if (Pos('DATUM',RStr) > 0) or (Pos('DATE',RStr) > 0) then begin
FmtWrite(Result,
' %s:= StrDate(DBTable.FieldByName(%s%s%s).AsString);'+CRLF,
[ArrName,Zeichen,FeldName,Zeichen]);
end
else begin
FmtWrite(Result,
' %s:= DBTable.FieldByName(%s%s%s).AsInteger;'+CRLF,
[ArrName,Zeichen,FeldName,Zeichen]);
end;
end
else if Pos('REAL',RStr) > 0 then begin
FmtWrite(Result,
' %s:= DBTable.FieldByName(%s%s%s).AsFloat;'+CRLF,
[ArrName,Zeichen,FeldName,Zeichen]);
end
else if Pos('BOOLEAN',RStr) > 0 then begin
FmtWrite(Result,
' %s:= DBTable.FieldByName(%s%s%s).AsBoolean;'+CRLF,
[ArrName,Zeichen,FeldName,Zeichen]);
end
else if Pos('MEMO',RStr) > 0 then begin
FmtWrite(Result,
' M:= TMemo.Create(Application);'+CRLF+
' M.Lines.Assign(DBTable.FieldByName(%s%s%s));'+CRLF+
' M.GetTextBuf(MStr,800);'+CRLF+
' Move(MStr,%s,Sizeof(%s));'+CRLF+
' M.Free;'+CRLF,
[Zeichen,FeldName,Zeichen,ArrName,ArrName]);
end
else if (Pos('CHAR',RStr) > 0) and (Pos('ARRAY',RStr) = 0) then begin
FmtWrite(Result,
' %s:= DBTable.FieldByName(%s%s%s).AsString[1];'+CRLF,
[ArrName,Zeichen,FeldName,Zeichen]);
end
else begin
FmtWrite(Result,
' %s:= DBTable.FieldByName(%s%s%s).AsString;'+CRLF,
[ArrName,Zeichen,FeldName,Zeichen]);
end;
end;
end;
end;
end;
FmtWrite(Result,
' end;'+CRLF+
'end;'+CRLF+CRLF,[NIL]);
end;
FmtWrite(Result,
'Function %sKeyProc(Var Daten; KeyNr:Word): IsamKeyStr;'+CRLF+
'var s : String;'+CRLF+
'begin'+CRLF+
' s:= '+Chr(39)+Chr(39)+';'+CRLF,[RecordName]);
FmtWrite(Result,
' With %s(Daten) do begin'+CRLF+
' case KeyNr of'+CRLF,[RecordName]);
if KeyList.Count > 0 then begin
k:= 0;
For x:= 0 to KeyList.Count-1 do begin
NStr:= KeyList[x];
NStr:= UpperCase(NStr);
Strip(NStr);
if (Pos('KEYBEGIN',NStr) = 0) and (Pos('KEYEND',NStr) = 0) then begin
inc(K);
Str(k,xStr);
FmtWrite(Result,
' %s: %s'+CRLF,[xStr,KeyList[x]]);
end;
end;
end
else FmtWrite(Result,
' 1 : S:= '+Chr(39)+Chr(39)+';'+CRLF,[NIL]);
FmtWrite(Result,
' end;'+CRLF+
' end;' +CRLF+
' %sKEYPROC:= S;'+CRLF+
'end;'+CRLF+CRLF,[RecordName]);
FmtWrite(Result,
'procedure T%s.ShowHint(Sender: TObject);'+CRLF+
'begin'+ CRLF +
' StatusBar.Caption := Application.Hint;'+CRLF+
'end;'+CRLF+CRLF,[FormIdent]);
FmtWrite(Result,
'procedure T%s.FormCreate(Sender: TObject);'+CRLF+
'var AktDir: String;' + CRLF +
'begin' + CRLF +
' AktDir:= ExtractFilePath(Application.ExeName);'+CRLF,[FormIdent]);
Str(Sprache,SStr);
FmtWrite(Result,
' KeyListe:= TStringList.Create;'+CRLF+
' {Sprache:= %s; 0 = German 1 = English}'+CRLF+
' Set_Language;'+CRLF,[SStr]);
if KeyList.Count > 0 then begin
For i:= 0 to KeyList.Count-1 do begin
NStr:= KeyList[i];
if Pos('S:=',NStr) > 0 then begin
Delete(NStr,1,Pos('S:=',NStr)+2);
While (Length(NStr) > 0) and (NStr[1] = ' ') do Delete(NStr,1,1);
if Pos(',',NStr) > 0 then NStr:= Copy(NStr,1,Pos(',',NStr)-1)
else if Pos(';',NStr) > 0 then NStr:= Copy(NStr,1,Pos(';',NStr)-1)
else if Pos('{',NStr) > 0 then NStr:= Copy(NStr,1,Pos('{',NStr)-1);
if Pos('}',NStr) > 0 then Delete(NStr,1,Pos('}',NStr));
if Pos('(',NStr) > 0 then Delete(NStr,1,Pos('(',NStr));
While (Length(NStr) > 0) and (NStr[1] = ' ') do Delete(NStr,1,1);
FmtWrite(Result,' KeyListe.Add('+Chr(39)+'%s'+Chr(39)+');'+CRLF,[NStr]);
end;
end;
end;
FmtWrite(Result,
' if KeyListe.Count > 0 then KeyPanel.Caption:= '+
Chr(39)+'Sort: '+Chr(39)+'+KeyListe[0];'+CRLF,[NIL]);
FmtWrite(Result,
' Application.OnHint := ShowHint;'+CRLF+
' with %sTable do begin'+CRLF+
' Key_Proc := %sKEYPROC;'+CRLF,[FormIdent,RecordName]);
FmtWrite(Result,
' Recsize:= Sizeof(%s);'+CRLF,[RecordName]);
if IIDList.Count > 0 then begin
For x:= 0 to IIDList.Count-1 do FmtWrite(Result,
' %s'+CRLF,[IIDList[x]]);
end
else FmtWrite(Result,
' IID[1].KeyL := 0; IID[1].AllowDupK := False;'+CRLF,[NIL]);
FmtWrite(Result,
' Active:= True;'+CRLF+
' end;'+CRLF+
' if %sTable.Active then begin'+CRLF,[FormIdent]);
FmtWrite(Result,
' %sBrowser1.OnBuildRow:= %sBrowser1BuildRow;'+CRLF+
' %sBrowser1.ConnectLowBrowser(New(PLowWinBrowser, Init(True, %sTable.IFBPTR,'+CRLF+
' 1, 50, 1, '+Chr(39)+Chr(39)+', '+Chr(39)+Chr(39)+', %sData, False )));'+CRLF,
[RecordName,RecordName,RecordName,FormIdent,RecordName]);
FmtWrite(Result,
' %sBrowser1.SetAndUpdateBrowserScreen('+Chr(39)+Chr(39)+', 0);'+CRLF+
' end;'+CRLF+
' %sBrowser1.BrowserHeader:= Header1;'+CRLF,[RecordName,RecordName]);
FmtWrite(Result,
' ActiveControl:= %sBrowser1;'+CRLF+
' Header1.OnSized:= Header1Sized;'+CRLF+
'end;'+CRLF+CRLF,[RecordName]);
FmtWrite(Result,
'Procedure T%s.Set_Language;'+CRLF+
'begin'+CRLF+
' if Sprache = 1 then begin {English}'+CRLF+
' NeuBttn.Hint := '+Chr(39)+'New record'+Chr(39)+';'+CRLF,[FormIdent]);
FmtWrite(Result,
' EditBttn.Hint := '+Chr(39)+'Edit record'+Chr(39)+';'+CRLF+
' SuchBttn.Hint := '+Chr(39)+'Search'+Chr(39)+';'+CRLF+
' KeyBttn.Hint := '+Chr(39)+'sort-order'+Chr(39)+';'+CRLF+
' LoeschBttn.Hint:= '+Chr(39)+'Delete'+Chr(39)+';'+CRLF,[NIL]);
FmtWrite(Result,
' ReorgBttn.Hint := '+Chr(39)+'Reorganize table'+Chr(39)+';'+CRLF+
' BrwBttn.Hint := '+Chr(39)+'Setup browser'+Chr(39)+';'+CRLF,[NIL]);
if CreaBttn then begin
FmtWrite(Result,
' CreateBttn.Hint:= '+Chr(39)+'Create table'+Chr(39)+';'+CRLF,[NIL]);
end;
FmtWrite(Result,
' end'+CRLF+
' else begin'+CRLF+
' NeuBttn.Hint := '+Chr(39)+'Neuer Datensatz'+Chr(39)+';'+CRLF+
' EditBttn.Hint := '+Chr(39)+'Datensatz bearbeiten'+Chr(39)+';'+CRLF,[NIL]);
FmtWrite(Result,
' SuchBttn.Hint := '+Chr(39)+'Daten suchen'+Chr(39)+';'+CRLF+
' KeyBttn.Hint := '+Chr(39)+'Sortierordnung'+Chr(39)+';'+CRLF+
' LoeschBttn.Hint:= '+Chr(39)+'Datensatz l÷schen'+Chr(39)+';'+CRLF+
' ReorgBttn.Hint := '+Chr(39)+'Tabelle reorganisieren'+Chr(39)+';'+CRLF+
' BrwBttn.Hint := '+Chr(39)+'Browser einstellen'+Chr(39)+';'+CRLF,[NIL]);
if CreaBttn then begin
FmtWrite(Result,
' CreateBttn.Hint:= '+Chr(39)+'Tabelle erzeugen'+Chr(39)+';'+CRLF,[NIL]);
end;
FmtWrite(Result,
' end;'+CRLF+
'end;'+CRLF,[NIL]);
if alsMainForm then NStr:= 'Close' else NStr:= 'ModalResult:= mrOk';
FmtWrite(Result,
'procedure T%s.ExitBttnClick(Sender: TObject);'+CRLF+
'begin'+CRLF+
' %s;'+CRLF+
'end;'+CRLF+CRLF,[FormIdent,NStr]);
if Sprache = 1 then SStr:= 'Reorganize table ?'
else SStr:= 'Tabelle reorganisieren ?';
FmtWrite(Result,
'Procedure T%s.ReorgBttnClick(Sender: TObject);'+CRLF+
'var Txt1: String;'+CRLF+
'begin'+CRLF,[FormIdent]);
FmtWrite(Result,
' if Sprache = 1 then Txt1:= '+Chr(39)+'Reorganize table ?'+Chr(39)+CRLF+
' else Txt1:= '+Chr(39)+'Tabelle reorganisieren ?'+Chr(39)+';'+CRLF+
' if JaNein(Txt1,'+Chr(39)+Chr(39)+') then begin'+CRLF+
' %sTable.Rebuild;'+CRLF,[FormIdent]);
FmtWrite(Result,
' if %sBrowser1.GetLowBrowser <> NIL then'+CRLF+
' %sBrowser1.GetLowBrowser^.UsedFileBlock:= %sTable.IfbPtr;'+CRLF+
' end;'+CRLF+
'end;'+CRLF+CRLF,[RecordName,RecordName,FormIdent]);
FmtWrite(Result,
'Procedure T%s.BrwBttnClick(Sender: TObject);'+CRLF+
'begin'+CRLF+
' %sBrowser1.SetupBrowser(Self);'+CRLF+
'end;'+CRLF+CRLF,[FormIdent,RecordName]);
FmtWrite(Result,
'procedure T%s.FormDestroy(Sender: TObject);'+CRLF+
'begin'+CRLF+
' if %sTable.Active then %sTable.Close;'+CRLF,[FormIdent,FormIdent,FormIdent]);
FmtWrite(Result,
' KeyListe.Free;'+CRLF+
'end;'+CRLF+CRLF,[NIL]);
FmtWrite(Result,
'procedure T%s.EditBttnClick(Sender: TObject);'+CRLF+
'begin'+CRLF+
' %s:= T%s.Create(Self);'+CRLF+
' Try'+CRLF,[FormIdent,EditFormIdent,EditFormIdent]);
FmtWrite(Result,
' %sTable.Ref:= %sBrowser1.GetCurrentDatRef;'+CRLF+
' %s.%sTable:= %sTable;'+CRLF,
[FormIdent,RecordName,EditFormIdent,EditFormIdent,FormIdent]);
FmtWrite(Result,
' %s.SetData;'+CRLF+
' %sTable.FindKey(%sData,%sDup,%sTable.Key);'+CRLF,
[EditFormIdent,FormIdent,RecordName,RecordName,FormIdent]);
FmtWrite(Result,
' %s.ShowModal;'+CRLF+
' Finally'+CRLF+
' %s.Free;'+CRLF,[EditFormIdent,EditFormIdent]);
FmtWrite(Result,
' Application.OnHint:= ShowHint;' + CRLF +
' %sBrowser1.SetAndUpdateBrowserScreen(%sTable.Key,%sTable.Ref);'+CRLF,[RecordName,FormIdent,FormIdent]);
FmtWrite(Result,
' End;'+CRLF+
'end;'+CRLF+CRLF,[NIL]);
FmtWrite(Result,
'procedure T%s.NeuBttnClick(Sender: TObject);'+CRLF+
'begin'+CRLF+
' %s:= T%s.Create(Self);'+CRLF+
' Try'+CRLF,[FormIdent,EditFormIdent,EditFormIdent]);
FmtWrite(Result,
' %s.%sTable:= %sTable;'+CRLF,
[EditFormIdent,EditFormIdent,FormIdent]);
FmtWrite(Result,
' %s.LeerData;'+CRLF,[EditFormIdent]);
FmtWrite(Result,
' %s.ShowModal;'+CRLF+
' Finally'+CRLF+
' %s.Free;'+CRLF,[EditFormIdent,EditFormIdent]);
FmtWrite(Result,
' Application.OnHint:= ShowHint;'+ CRLF +
' End;'+CRLF+
'end;'+CRLF+CRLF,[NIL]);
if Sprache = 1 then SStr:= 'Delete record ?'
else SStr:= 'Datensatz l÷schen ?';
FmtWrite(Result,
'procedure T%s.LoeschBttnClick(Sender: TObject);'+CRLF+
'var Key1,Txt1: String;'+CRLF+
'begin'+CRLF,[FormIdent]);
FmtWrite(Result,
' %sTable.Ref:= %sBrowser1.GetCurrentDatRef;'+CRLF+
' %sTable.Get(%sData,%sDup);'+CRLF,
[FormIdent,RecordName,FormIdent,RecordName,RecordName]);
FmtWrite(Result,
' Key1:= %sTable.Key_Proc(%sData,%sTable.KeyNo);'+CRLF+
' if Sprache = 1 then Txt1:= '+Chr(39)+'Delete '+Chr(39)+'+Key1+'+Chr(39)+' ?'+Chr(39)+CRLF+
' else Txt1:= '+Chr(39)+'Datensatz '+Chr(39)+'+Key1+'+Chr(39)+' l÷schen ?'+Chr(39)+';'+CRLF,
[FormIdent,RecordName,FormIdent]);
FmtWrite(Result,
' if Janein(Txt1,'+Chr(39)+Chr(39)+') then %sTable.Delete(%sData,%sDup);'+CRLF,
[FormIdent,RecordName,RecordName]);
FmtWrite(Result,
' %sbrowser1.SetAndUpdateBrowserScreen(%sTable.Key,%sTable.Ref);'+CRLF+
'end;'+CRLF+CRLF,
[RecordName,FormIdent,FormIdent]);
FmtWrite(Result,
'procedure T%s.SuchBttnClick(Sender: TObject);' + CRLF +
'var Ref: Longint;'+CRLF+
' Key: IsamKeyStr;'+CRLF,[FormIdent]);
FmtWrite(Result,
'begin'+CRLF,[NIL]);
FmtWrite(Result,
' if Such_Einstellen(%sTable,Self,%sData,%sDup,Ref,Key,KeyListe) then begin' + CRLF +
' %sBrowser1.KeyNumber := %sTable.KeyNo;'+CRLF+
' if KeyListe.Count > 0 then KeyPanel.Caption:= '+
Chr(39)+'Sort: '+Chr(39)+'+KeyListe[%sTable.KeyNo-1];'+CRLF,
[FormIdent,RecordName,RecordName,RecordName,FormIdent,FormIdent]);
FmtWrite(Result,
' %sBrowser1.SetAndUpdateBrowserScreen(Key, Ref);'+CRLF+
' Key_Speichern(GetAppName,%sBrowser1.Name,%sTable.KeyNo);'+CRLF,[RecordName,RecordName,FormIdent]);
FmtWrite(Result,
' end;'+CRLF+
'end;'+ CRLF + CRLF, [NIL]);
FmtWrite(Result,
'procedure T%s.KeyBttnClick(Sender: TObject);' + CRLF +
'var Key1: Integer;'+CRLF,[FormIdent]);
FmtWrite(Result,
'begin'+CRLF+
' Key1:= %sTable.KeyNo;'+CRLF,[FormIdent]);
FmtWrite(Result,
' Key_Einstellen(Self,Key1,KeyListe);'+CRLF,[NIL]);
FmtWrite(Result,
' %sTable.KeyNo:= Key1;'+CRLF+
' if KeyListe.Count > 0 then KeyPanel.Caption:= '+
Chr(39)+'Sort: '+Chr(39)+'+KeyListe[Key1-1];'+CRLF,
[FormIdent]);
FmtWrite(Result,
' %sBrowser1.KeyNumber := Key1;'+CRLF,[RecordName]);
FmtWrite(Result,
' Key_Speichern(GetAppName,%sBrowser1.Name,%sTable.KeyNo);'+CRLF+
' %sBrowser1.SetAndUpdateBrowserScreen('+Chr(39)+Chr(39)+', 0);'+CRLF+
'end;'+ CRLF + CRLF, [RecordName,FormIdent,RecordName]);
FmtWrite(Result,
'procedure T%s.%sTimerTimer(Sender: TObject);'+ CRLF +
'var TStr: String;'+CRLF+
'begin'+ CRLF +
' TStr:= '+Chr(39)+Chr(39)+';'+CRLF,[FormIdent,FormIdent]);
FmtWrite(Result,
' DateTimeToString(TStr,'+Chr(39)+'dd.mm.yyyy hh:mm'+Chr(39)+',Now);'+CRLF+
' ZeitPanel.Caption:= TStr;' + CRLF +
'end;'+ CRLF + CRLF, [NIL]);
FmtWrite(Result,
'Procedure T%s.FormResize(Sender: TObject);'+CRLF+
'begin'+CRLF+
' %sBrowser1.Height := ClientHeight-Header1.Height - 10;'+CRLF,[FormIdent,RecordName]);
FmtWrite(Result,
' %sBrowser1.Width := ClientWidth - 2;'+CRLF+
'end;'+CRLF+CRLF,[RecordName]);
FmtWrite(Result,
'Procedure T%s.FormShow(Sender: TObject);'+CRLF+
'begin'+CRLF+
' %sTable.KeyNo:= %sBrowser1.ReadIni;'+CRLF+
' %sBrowser1.ClearIncss;'+CRLF,[FormIdent,FormIdent,RecordName,RecordName]);
FmtWrite(Result,
' %sBrowser1.KeyNumber := %sTable.KeyNo;'+CRLF+
' %sBrowser1.KeySection := 0;'+CRLF+
' {%sBrowser1.AllowIncSS := True;}'+CRLF,
[RecordName,FormIdent,RecordName,RecordName]);
FmtWrite(Result,
' if KeyListe.Count > 0 then KeyPanel.Caption:= '+
Chr(39)+'Sort: '+Chr(39)+'+KeyListe[%sTable.KeyNo-1];'+CRLF,
[FormIdent]);
FmtWrite(Result,
' %sBrowser1.SetAndUpdateBrowserScreen('+Chr(39)+Chr(39)+', 0);'+CRLF+
'end;'+CRLF+CRLF,[RecordName]);
FmtWrite(Result,
'Procedure T%s.Header1Sized(Sender: TObject; ASection, AWidth: Integer);'+CRLF+
'begin'+CRLF+
' %sBrowser1.ResizeHeader;'+CRLF,[FormIdent,RecordName]);
FmtWrite(Result,
' %sBrowser1.SetAndUpdateBrowserScreen('+Chr(39)+Chr(39)+', 0);'+CRLF+
'end;'+CRLF+CRLF,[RecordName]);
FmtWrite(Result,
'Function T%s.%sBrowser1BuildRow(Sender: TObject; var RR: RowRec): Integer;'+CRLF+
'begin'+CRLF+
' Result := NoError;'+CRLF,[FormIdent,RecordName]);
FmtWrite(Result,
' Satzlesen(%sTable.IfbPtr,RR.Ref,%sData,%sDup);'+CRLF+
' with %sData do begin'+CRLF+
' if RR.Status <> NoError then begin'+CRLF,[FormIdent,RecordName,RecordName,RecordName]);
FmtWrite(Result,
' RR.Row := F('+Chr(39)+'**** '+Chr(39)+' + RR.IKS, MaxCols);'+CRLF+
' end else begin'+CRLF+
' RR.Row:= %sBrowser1.GetRow(%sGetFeldProc,%sData);'+CRLF,[RecordName,RecordName,RecordName]);
FmtWrite(Result,
' end;'+CRLF+
' end;'+CRLF+
'end;'+CRLF+CRLF,[NIL]);
if DBASE_Export then begin
FmtWrite(Result,
'procedure T%s.DbExpBttnClick(Sender: TObject);'+CRLF+
'begin'+CRLF,[FormIdent]);
FmtWrite(Result,
' Isam2DBase(Self,%sTable,%sTable.TableName,'+CRLF+
' '+Chr(39)+'%s'+Chr(39)+', %s_Struktur, %sDbaseExportProc);'+CRLF+
'end;'+CRLF+CRLF,[FormIdent,FormIdent,AliasName,RecordName,RecordName]);
end;
if DBASE_Import then begin
FmtWrite(Result,
'procedure T%s.DbImpBttnClick(Sender: TObject);'+CRLF+
'begin'+CRLF,[FormIdent]);
FmtWrite(Result,
' DBase2Isam(Self,%sTable,%sTable.TableName,'+CRLF+
' '+Chr(39)+'%s'+Chr(39)+', %sDbaseImportProc);'+CRLF,
[FormIdent,FormIdent,AliasName,RecordName]);
FmtWrite(Result,
' %sBrowser1.SetAndUpdateBrowserScreen('+Chr(39)+Chr(39)+', 0);'+CRLF+
'end;'+CRLF+CRLF,[RecordName]);
end;
if CreaBttn then begin
FmtWrite(Result,
'procedure T%s.CreateBttnClick(Sender: TObject);'+CRLF+
'begin'+CRLF+
' if Password(_PW) then begin'+CRLF,[FormIdent]);
FmtWrite(Result,
' with %sTable do begin'+CRLF+
' Key_Proc := %sKEYPROC;'+CRLF,[FormIdent,RecordName]);
FmtWrite(Result,
' Recsize:= Sizeof(%s);'+CRLF,[RecordName]);
if IIDList.Count > 0 then begin
For x:= 0 to IIDList.Count-1 do FmtWrite(Result,
' %s'+CRLF,[IIDList[x]]);
FmtWrite(Result,
' end;'+CRLF,[NIL]);
end
else FmtWrite(Result,
' IID[1].KeyL := 0; IID[1].AllowDupK := False;'+CRLF+
' end;'+CRLF,[NIL]);
FmtWrite(Result,
' %sTable.CreateTable;'+CRLF+
' %sTable.Open;'+CRLF+
' %sBrowser1.SetAndUpdateBrowserScreen('+Chr(39)+Chr(39)+', 0);'+CRLF+
' end;'+CRLF+
'end;'+CRLF,[FormIdent,FormIdent,RecordName]);
end;
if SetupBttnCheck then begin
FmtWrite(Result,
'procedure T%s.SetupBttnClick(Sender: TObject);'+CRLF+
'begin'+CRLF+
' if Password(_PW) then begin'+CRLF,[FormIdent]);
FmtWrite(Result,
' LWSetup:= TLwSetup.Create(Self);'+CRLF+
' Try'+CRLF+
' LWSetup.ShowModal;'+CRLF,[NIL]);
FmtWrite(Result,
' Finally'+CRLF+
' LWSetup.Free;'+CRLF+
' End;'+CRLF,[NIL]);
FmtWrite(Result,
' Set_Language;'+CRLF+
' end;'+CRLF+
'end;'+CRLF,[NIL]);
end;
FmtWrite(Result, 'end.' + CRLF, [nil]);
DBFeldList.Free;
Result.Position := 0;
except
Result.Free;
raise;
end;
finally
StrDispose(SourceBuffer);
end;
end;
function Erzeuge_EditorSource(const UnitIdent, FormIdent: string;
RecList,KeyList: TStringList;
Sprache: Integer;
TypDateiName: String): TMemoryStream;
const
CRLF = #13#10;
Var Decimals,I,Len,Arr1,Arr2,a: integer;
G: Byte;
FieldDataType: TFieldType;
RecordName,FieldName,FeldName,FldName,NStr,SStr,RStr,AStr,DStr: String;
MemoName: String;
begin
SourceBuffer := StrAlloc(SourceBufferSize);
try
Result := TMemoryStream.Create;
try
{ unit header and uses clause }
FmtWrite(Result,
'unit %s;' + CRLF + CRLF +
'interface' + CRLF + CRLF +
'uses'#13#10 +
' SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,'#13#10 +
' StdCtrls, ExtCtrls, Forms', [UnitIdent]);
{$IFDEF NEWINPUTS}
FmtWrite(Result,
',DateEdit, NumCtrl, Buttons,'+CRLF,[NIL]);
{$ELSE}
FmtWrite(Result,
',Buttons,'+CRLF,[NIL]);
{$ENDIF}
FmtWrite(Result,
' IsamTabl;' + CRLF + CRLF, [nil]);
{ begin the class declaration }
RecordName:= '';
MemoName:= '';
FmtWrite(Result,'{$I %s}'+CRLF+CRLF,[TypDateiname]);
if RecList.Count > 0 then begin
For i:= 0 to RecList.Count - 1 do begin
{FmtWrite(Result,' %s'+CRLF,[RecList[i]]);}
RStr:= Uppercase(RecList[i]);
Strip(RStr);
if Pos('=RECORD',RStr) > 0 then RecordName:= Copy(RStr,1,Pos('=RECORD',RStr)-1);
end;
end;
FmtWrite(Result,
'type'#13#10 +
' T%s = class(TForm)'#13#10, [FormIdent]);
FmtWrite(Result,
' Panel1 : TPanel;' + CRLF +
' Panel2 : TPanel;' + CRLF +
' ZeitPanel: TPanel;'+ CRLF +
' HintPanel: TPanel;'+ CRLF +
' %sTimer : TTimer;'+ CRLF,[FormIdent]);
FmtWrite(Result,
' RueckBttn: TSpeedButton;' + CRLF +
' VorBttn: TSpeedButton;' + CRLF +
' SuchBttn: TSpeedButton;' + CRLF +
' KeyBttn: TSpeedButton;' + CRLF +
' NeuBttn: TSpeedButton;' + CRLF,[NIL]);
FmtWrite(Result,
' AnlegBttn: TSpeedButton;' + CRLF +
' AendernBttn: TSpeedButton;' + CRLF,[NIL]);
FmtWrite(Result,
' LoeschBttn: TSpeedButton;' + CRLF +
' OkBttn: TSpeedButton;' + CRLF +
' AbbruchBttn: TSpeedButton;' + CRLF, [NIL]);
FmtWrite(Result,
' %sTable: TIsamTable;'+CRLF,[FormIdent]);
if RecList.Count > 0 then begin
For i:= 0 to RecList.Count-1 do begin
SStr:= RecList[i];
if (Pos(':',SStr) > 0) and (Pos('DUMMY',UpperCase(SStr)) = 0)
and (Pos('IGNORE',Uppercase(SStr)) = 0) then begin
G:= GetFieldTypEditor(SStr,FeldName,FieldDataType,Len,Arr1,Arr2,Decimals);
FieldName:= FeldName;
FldName:= FeldName;
For a:= Arr1 to Arr2 do begin
if Arr1 <> Arr2 then begin
Str(A,AStr);
FieldName:= FeldName+AStr;
end;
{$IFDEF NEWINPUTS}
Case G of
1: FmtWrite(Result,
' %sInput: TDateEdit;'+CRLF+
' %sLabel: TLabel;'+CRLF,[FieldName,FieldName]);
2: FmtWrite(Result,
' %sInput: TNumEdit;'+CRLF+
' %sLabel: TLabel;'+CRLF,[FieldName,FieldName]);
3: begin
FmtWrite(Result,
' %sInput: TMemo;'+CRLF+
' %sLabel: TLabel;'+CRLF,[FieldName,FieldName]);
MemoName:= FieldName;
end;
4: begin
FmtWrite(Result,
' %sInput: TRadioGroup;'+CRLF+
' %sLabel: TLabel;'+CRLF,[FieldName,FieldName]);
end;
else FmtWrite(Result,
' %sInput: TStrEdit;'+CRLF+
' %sLabel: TLabel;'+CRLF,[FieldName,FieldName]);
end;
{$ELSE}
Case G of
1: FmtWrite(Result,
' %sInput: TEdit;'+CRLF+
' %sLabel: TLabel;'+CRLF,[FieldName,FieldName]);
2: FmtWrite(Result,
' %sInput: TEdit;'+CRLF+
' %sLabel: TLabel;'+CRLF,[FieldName,FieldName]);
3: begin
FmtWrite(Result,
' %sInput: TMemo;'+CRLF+
' %sLabel: TLabel;'+CRLF,[FieldName,FieldName]);
MemoName:= FieldName;
end;
4: begin
FmtWrite(Result,
' %sInput: TRadioGroup;'+CRLF+
' %sLabel: TLabel;'+CRLF,[FieldName,FieldName]);
end;
else FmtWrite(Result,
' %sInput: TEdit;'+CRLF+
' %sLabel: TLabel;'+CRLF,[FieldName,FieldName]);
end;
{$ENDIF}
end; {for arr1 to arr2}
end;
end;
end;
FmtWrite(Result,
' procedure FormCreate(Sender: TObject);' + CRLF +
' procedure FormDestroy(Sender: TObject);' + CRLF +
' procedure VorBttnClick(Sender: TObject);' + CRLF,[NIL]);
FmtWrite(Result,
' procedure RueckBttnClick(Sender: TObject);' + CRLF +
' procedure NeuBttnClick(Sender: TObject);' + CRLF +
' procedure OkBttnClick(Sender: TObject);' + CRLF,[NIL]);
FmtWrite(Result,
' procedure AbbruchBttnClick(Sender: TObject);' + CRLF,[NIL]);
FmtWrite(Result,
' procedure AendernBttnClick(Sender: TObject);' + CRLF +
' procedure AnlegBttnClick(Sender: TObject);' + CRLF,[NIL]);
FmtWrite(Result,
' procedure LoeschBttnClick(Sender: TObject);' + CRLF +
' procedure SuchBttnClick(Sender: TObject);' + CRLF +
' procedure KeyBttnClick(Sender: TObject);' + CRLF, [NIL]);
FmtWrite(Result,
' Procedure ShowHint(Sender: TObject); ' + CRLF +
' Procedure %sTimerTimer(Sender: TObject);' + CRLF,[FormIdent]);
FmtWrite(Result,
' Procedure FormKeyPress(Sender: TObject; var Key: Char);'+CRLF+
' private'+CRLF+
' KeyListe: TStringList;'+CRLF,[NIL]);
FmtWrite(Result,
' Function IsModified: Boolean;' + CRLF +
' Procedure ResetModified;' + CRLF+
' Procedure Set_Language;'+CRLF,[NIL]);
FmtWrite(Result,
' public' + CRLF,[NIL]);
FmtWrite(Result,
' Procedure SetData;' + CRLF +
' Procedure LeerData;' + CRLF +
' Procedure GetData;' + CRLF,
[nil]);
FmtWrite(Result,
' end;' + CRLF + CRLF +
'var' + CRLF +
' %s: T%s;' + CRLF + CRLF,[FormIdent, FormIdent]);
FmtWrite(Result,
' %sData,%sDup: %s;' + CRLF + CRLF,[RecordName,RecordName,RecordName]);
FmtWrite(Result,
'implementation' + CRLF + CRLF +
'Uses UToolDll, Isam_Key, IsamSuch, Filer, MyBubble, Dat;' + CRLF + CRLF +
'{$R *.DFM}' + CRLF + CRLF, [NIL]);
FmtWrite(Result,
'procedure T%s.FormCreate(Sender: TObject);' + CRLF +
'begin' + CRLF +
' Application.OnHint:= ShowHint;' + CRLF,[FormIdent]);
Str(Sprache,SStr);
FmtWrite(Result,
' KeyListe:= TStringList.Create;'+CRLF+
' {Sprache:= %s; 0 = German 1 = English}'+CRLF+
' Set_Language;'+CRLF,[SStr]);
if KeyList.Count > 0 then begin
For i:= 0 to KeyList.Count-1 do begin
NStr:= KeyList[i];
if Pos('S:=',NStr) > 0 then begin
Delete(NStr,1,Pos('S:=',NStr)+2);
While (Length(NStr) > 0) and (NStr[1] = ' ') do Delete(NStr,1,1);
if Pos(',',NStr) > 0 then NStr:= Copy(NStr,1,Pos(',',NStr)-1)
else if Pos(';',NStr) > 0 then NStr:= Copy(NStr,1,Pos(';',NStr)-1)
else if Pos('{',NStr) > 0 then NStr:= Copy(NStr,1,Pos('{',NStr)-1);
if Pos('}',NStr) > 0 then Delete(NStr,1,Pos('}',NStr));
if Pos('(',NStr) > 0 then Delete(NStr,1,Pos('(',NStr));
While (Length(NStr) > 0) and (NStr[1] = ' ') do Delete(NStr,1,1);
FmtWrite(Result,' KeyListe.Add('+Chr(39)+'%s'+Chr(39)+');'+CRLF,[NStr]);
end;
end;
end;
FmtWrite(Result,
'end;' + CRLF + CRLF,[NIL]);
FmtWrite(Result,
'Procedure T%s.Set_Language;'+CRLF+
'begin'+CRLF+
' if Sprache = 1 then begin {English}'+CRLF+
' VorBttn.Hint := '+Chr(39)+'Forward'+Chr(39)+';'+CRLF,[FormIdent]);
FmtWrite(Result,
' RueckBttn.Hint := '+Chr(39)+'Back'+Chr(39)+';'+CRLF+
' SuchBttn.Hint := '+Chr(39)+'Search'+Chr(39)+';'+CRLF+
' KeyBttn.Hint := '+Chr(39)+'sort-order'+Chr(39)+';'+CRLF+
' NeuBttn.Hint := '+Chr(39)+'Clear'+Chr(39)+';'+CRLF,[NIL]);
FmtWrite(Result,
' AnlegBttn.Hint := '+Chr(39)+'Save new record'+Chr(39)+';'+CRLF+
' AendernBttn.Hint:= '+Chr(39)+'Save changed record'+Chr(39)+';'+CRLF+
' LoeschBttn.Hint := '+Chr(39)+'Delete record'+Chr(39)+';'+CRLF+
' AbbruchBttn.Hint:= '+chr(39)+'End'+Chr(39)+';'+CRLF,[NIL]);
FmtWrite(Result,
' end'+CRLF+
' else begin'+CRLF+
' VorBttn.Hint := '+Chr(39)+'VorwΣrts'+Chr(39)+';'+CRLF+
' RueckBttn.Hint := '+Chr(39)+'Zurⁿck'+Chr(39)+';'+CRLF,[NIL]);
FmtWrite(Result,
' SuchBttn.Hint := '+Chr(39)+'Daten suchen'+Chr(39)+';'+CRLF+
' KeyBttn.Hint := '+Chr(39)+'Sortierordnung'+Chr(39)+';'+CRLF+
' NeuBttn.Hint := '+Chr(39)+'Eingabe leeren'+Chr(39)+';'+CRLF+
' AnlegBttn.Hint := '+Chr(39)+'Datensatz anlegen'+Chr(39)+';'+CRLF,[NIL]);
FmtWrite(Result,
' AendernBttn.Hint:= '+Chr(39)+'Datensatz Σndern'+Chr(39)+';'+CRLF+
' LoeschBttn.Hint := '+Chr(39)+'Datensatz l÷schen'+Chr(39)+';'+CRLF+
' AbbruchBttn.Hint:= '+chr(39)+'Ende'+Chr(39)+';'+CRLF,[NIL]);
FmtWrite(Result,
' end;'+CRLF+
'end;'+CRLF+CRLF,[NIL]);
FmtWrite(Result,
'procedure T%s.FormDestroy(Sender: TObject);'+CRLF+
'begin'+CRLF+
' KeyListe.Free;'+CRLF+
'end;'+CRLF+CRLF,[FormIdent]);
FmtWrite(Result,
'Function T%s.IsModified: Boolean;' + CRLF +
'var M: Boolean;' + CRLF +
' i: Integer;' + CRLF +
'begin' + CRLF +
' M:= False;' + CRLF +
' if ComponentCount > 0 then begin' + CRLF +
' i:= 0;' + CRLF,[FormIdent]);
FmtWrite(Result,
' Repeat' + CRLF +
' if Components[i] is TEdit then begin' + CRLF +
' if TEdit(Components[i]).Modified then M:= True;'+ CRLF +
' end' + CRLF +
' else if Components[i] is TMemo then begin' + CRLF +
' if TMemo(Components[i]).Modified then M:= True;'+ CRLF,[NIL]);
{$IFDEF NEWINPUTS}
FmtWrite(Result,
' end'+CRLF+
' else if (Components[i] is TNumEdit) then begin' + CRLF +
' if TNumEdit(Components[i]).Modified then M:= True;'+ CRLF,[NIL]);
FmtWrite(Result,
' end'+CRLF+
' else if (Components[i] is TStrEdit) then begin'+CRLF+
' if TStrEdit(Components[i]).Modified then M:= True;'+CRLF,[NIL]);
FmtWrite(Result,
' end'+CRLF+
' else if (Components[i] is TDateEdit) then begin' + CRLF +
' if TDateEdit(Components[i]).Modified then M:= True;'+ CRLF +
' end;'+CRLF,[NIL]);
{$ELSE}
FmtWrite(Result,
' end;'+CRLF,[NIL]);
{$ENDIF}
FmtWrite(Result,
' inc(i);' + CRLF +
' Until (i >= ComponentCount) or (M = True);' + CRLF +
' end;' + CRLF +
' IsModified:= M;' + CRLF +
'end;' + CRLF + CRLF, [NIL]);
FmtWrite(Result,
'procedure T%s.ResetModified;' + CRLF +
'var i: Integer;' + CRLF +
'begin' + CRLF +
' if ComponentCount > 0 then begin' + CRLF +
' i:= 0;' + CRLF, [FormIdent]);
FmtWrite(Result,
' Repeat' + CRLF +
' if Components[i] is TEdit then begin' + CRLF +
' TEdit(Components[i]).Modified:= False;' + CRLF +
' end' + CRLF,[NIL]);
FmtWrite(Result,
' else if Components[i] is TMemo then begin' + CRLF +
' TMemo(Components[i]).Modified:= False;' + CRLF,[NIL]);
{$IFDEF NEWINPUTS}
FmtWrite(Result,
' end'+CRLF+
' else if (Components[i] is TDateEdit) then begin' + CRLF +
' TDateEdit(Components[i]).Modified:= False;' + CRLF,[NIL]);
FmtWrite(Result,
' end'+CRLF+
' else if (Components[i] is TStrEdit) then begin'+CRLF+
' TStrEdit(Components[i]).Modified:= False;' + CRLF,[NIL]);
FmtWrite(Result,
' end'+CRLF+
' else if (Components[i] is TNumEdit) then begin' + CRLF +
' TNumEdit(Components[i]).Modified:= False;'+ CRLF +
' end;'+CRLF,[NIL]);
{$ELSE}
FmtWrite(Result,
' end;' + CRLF,[NIL]);
{$ENDIF}
FmtWrite(Result,
' inc(i);' + CRLF +
' Until (i >= ComponentCount);' + CRLF +
' end;' + CRLF +
'end;' + CRLF + CRLF, [NIL]);
FmtWrite(Result,
'Procedure T%s.SetData;' + CRLF,[FormIdent]);
if MemoName <> '' then FmtWrite(Result,
'var MStr: Array[0..Sizeof(%sdata.%s)+1] of Char;'+CRLF,[RecordName,MemoName]);
FmtWrite(Result,
'begin' + CRLF+
' Fillchar(%sData,Sizeof(%sData),0);'+CRLF+
' %sTable.Get(%sData,%sDup);'+CRLF,[RecordName,
RecordName,FormIdent,RecordName,RecordName]);
{$IFDEF NEWINPUTS}
if RecList.Count > 0 then begin
FmtWrite(Result,' with %sData do begin'+CRLF,[RecordName]);
For i:= 0 to RecList.Count-1 do begin
SStr:= RecList[i];
if (Pos(':',SStr) > 0) and (Pos('DUMMY',UpperCase(SStr)) = 0)
and (Pos('IGNORE',Uppercase(SStr)) = 0) then begin
G:= GetFieldTypEditor(SStr,FeldName,FieldDataType,Len,Arr1,Arr2,Decimals);
FieldName:= FeldName;
FldName:= FeldName;
For a:= Arr1 to Arr2 do begin
if Arr1 <> Arr2 then begin
Str(A,AStr);
FieldName:= FeldName+'['+AStr+']';
FldName:= FeldName + AStr;
end;
case FieldDataType of
ftSmallInt,
ftBytes : FmtWrite(Result,
' %sInput.Value:= %s;'+CRLF,[FldName,FieldName]);
ftWord,
ftInteger : FmtWrite(Result,
' %sInput.Value:= %s;'+CRLF,[FldName,FieldName]);
ftDate : FmtWrite(Result,
' %sInput.Text:= DateStr(%s);'+CRLF,[FldName,FieldName]);
ftFloat : FmtWrite(Result,
' %sInput.Value:= %s;'+CRLF,[FldName,FieldName]);
ftMemo : FmtWrite(Result,
' Move(%s,MStr,Sizeof(%s));'+CRLF+
' %sInput.SetTextBuf(MStr);'+CRLF,[FieldName,FieldName,FldName,FieldName]);
ftBoolean : FmtWrite(Result,
' if %s then %sInput.ItemIndex:= 1 else %sInput.ItemIndex:= 0;'+CRLF,
[FieldName,FldName,FldName]);
else begin
if Len = 1 then FmtWrite(Result,
' %sInput.Text:= %s;'+CRLF,[FldName,FieldName])
else FmtWrite(Result,
' %sInput.Text:= String_oem2ansi(%sTable.AnsiConvert,%s);'+CRLF,[FldName,FormIdent,FieldName]);
end;
end;
end; {for arr1 to arr2}
end;
end;
FmtWrite(Result,' end;'+CRLF,[NIL]);
end;
{$ELSE}
if RecList.Count > 0 then begin
FmtWrite(Result,' with %sData do begin'+CRLF,[Recordname]);
For i:= 0 to RecList.Count-1 do begin
SStr:= RecList[i];
if (Pos(':',SStr) > 0) and (Pos('DUMMY',UpperCase(SStr)) = 0)
and (Pos('IGNORE',Uppercase(SStr)) = 0) then begin
G:= GetFieldTypEditor(SStr,FeldName,FieldDataType,Len,Arr1,Arr2,Decimals);
FieldName:= FeldName;
FldName:= FeldName;
For a:= Arr1 to Arr2 do begin
if Arr1 <> Arr2 then begin
Str(A,AStr);
FieldName:= FeldName+'['+AStr+']';
FldName:= FeldName + AStr;
end;
case FieldDataType of
ftSmallInt,
ftBytes : FmtWrite(Result,
' %sInput.Text:= IntStr(%s);'+CRLF,[FldName,FieldName]);
ftWord,
ftInteger : FmtWrite(Result,
' %sInput.Text:= IntStr(%s);'+CRLF,[FldName,FieldName]);
ftDate : FmtWrite(Result,
' %sInput.Text:= DateStr(%s);'+CRLF,[FldName,FieldName]);
ftFloat : begin
Str(Decimals,DStr);
FmtWrite(Result,
' %sInput.Text:= SimpleFormDezStr(%s,12,%s);'+CRLF,[FldName,FieldName,DStr]);
end;
ftMemo : FmtWrite(Result,
' Move(%s,MStr,Sizeof(%s));'+CRLF+
' %sInput.SetTextBuf(MStr);'+CRLF,[FieldName,FieldName,FldName,FieldName]);
ftBoolean : FmtWrite(Result,
' if %s then %sInput.ItemIndex:= 1 else %sInput.ItemIndex:= 0;'+CRLF,
[FieldName,FldName,FldName]);
else begin
if Len = 1 then FmtWrite(Result,
' %sInput.Text:= %s;'+CRLF,[FldName,FieldName])
else FmtWrite(Result,
' %sInput.Text:= String_oem2ansi(%sTable.AnsiConvert,%s);'+CRLF,[FldName,FormIdent,FieldName]);
end;
end;
end; {for arr1 to arr2}
end;
end;
FmtWrite(Result,' end;'+CRLF,[NIL]);
end;
{$ENDIF}
FmtWrite(Result,
' {AnlegBttn.Enabled:= False;}' + CRLF +
' {AendernBttn.Enabled:= True;}' + CRLF +
' {LoeschBttn.Enabled:= True;}' + CRLF +
' ResetModified;' + CRLF +
'end;'+ CRLF + CRLF, [NIL]);
FmtWrite(Result,
'Procedure T%s.GetData;' + CRLF +
'var Code: Integer;'+ CRLF,[FormIdent]);
if MemoName <> '' then FmtWrite(Result,
' MStr: Array[0..Sizeof(%sData.%s)+1] of Char;'+CRLF,
[RecordName,MemoName]);
FmtWrite(Result,
'begin' + CRLF,[NIL]);
if RecList.Count > 0 then begin
FmtWrite(Result,' Fillchar(%sData,Sizeof(%sData),0);'+CRLF,[RecordName,RecordName]);
FmtWrite(Result,' with %sData do begin'+CRLF,[RecordName]);
For i:= 0 to RecList.Count-1 do begin
SStr:= RecList[i];
if (Pos(':',SStr) > 0) and (Pos('DUMMY',UpperCase(SStr)) = 0)
and (Pos('IGNORE',Uppercase(SStr)) = 0) then begin
G:= GetFieldTypEditor(SStr,FeldName,FieldDataType,Len,Arr1,Arr2,Decimals);
FieldName:= FeldName;
FldName:= FeldName;
For a:= Arr1 to Arr2 do begin
if Arr1 <> Arr2 then begin
Str(A,AStr);
FieldName:= FeldName+'['+AStr+']';
FldName:= FeldName + AStr;
end;
Case FieldDataType of
ftSmallInt,
ftBytes : FmtWrite(Result,
' %s:= StrInt (%sInput.Text);'+CRLF,[FieldName,FldName]);
ftWord,
ftInteger : FmtWrite(Result,
' %s:= StrInt(%sInput.Text);'+CRLF,[FieldName,FldName]);
ftDate : FmtWrite(Result,
' %s:= StrDate(%sInput.Text);'+CRLF,[FieldName,FldName]);
ftFloat : FmtWrite(Result,
' %s:= StrDez (%sInput.Text);'+CRLF,[FieldName,FldName]);
ftMemo : FmtWrite(Result,
' %sInput.GetTextBuf(MStr,Sizeof(%s));' + CRLF+
' Move(MStr,%s,Sizeof(%s));'+CRLF
,[FldName,FieldName,FieldName,FieldName]);
ftBoolean : FmtWrite(Result,
' %s:= (%sInput.ItemIndex = 1);'+CRLF,[FieldName,FldName]);
else begin
if Len = 1 then FmtWrite(Result,
' %s:= %sInput.Text[1];'+CRLF,[FieldName,FldName])
else FmtWrite(Result,
' %s:= String_ansi2oem(%sTable.AnsiConvert,%sInput.Text);'+CRLF,
[FieldName,FormIdent,FldName]);
end;
end;
end; {for arr1 to arr2}
end;
end;
FmtWrite(Result,' end;'+CRLF,[NIL]);
end;
FmtWrite(Result,
'end;' + CRLF + CRLF, [NIL]);
FmtWrite(Result,
'Procedure T%s.LeerData;' + CRLF +
'begin' + CRLF,[FormIdent]);
{$IFDEF NEWINPUTS}
if RecList.Count > 0 then begin
For i:= 0 to RecList.Count-1 do begin
SStr:= RecList[i];
if (Pos(':',SStr) > 0) and (Pos('DUMMY',UpperCase(SStr)) = 0)
and (Pos('IGNORE',Uppercase(SStr)) = 0) then begin
G:= GetFieldTypEditor(SStr,FeldName,FieldDataType,Len,Arr1,Arr2,Decimals);
FieldName:= FeldName;
FldName:= FeldName;
For a:= Arr1 to Arr2 do begin
if Arr1 <> Arr2 then begin
Str(A,AStr);
FieldName:= FeldName+'['+AStr+']';
FldName:= FeldName + AStr;
end;
Case FieldDataType of
ftSmallInt,
ftBytes : FmtWrite(Result,
' %sInput.Value:= 0;'+ CRLF,[FldName]);
ftInteger,
ftWord : FmtWrite(Result,
' %sInput.Value:= 0;'+CRLF,[FldName]);
ftDate : FmtWrite(Result,
' %sInput.Text:= '+Chr(39)+Chr(39)+';'+ CRLF,[FldName]);
ftFloat : FmtWrite(Result,
' %sInput.Value:= 0;'+ CRLF,[FldName]);
ftMemo : FmtWrite(Result,
' %sInput.Lines.Clear;'+ CRLF,[FldName]);
ftBoolean : FmtWrite(Result,
' %sInput.ItemIndex:= 0;'+CRLF,[FldName]);
else FmtWrite(Result,
' %sInput.Text:= '+Chr(39)+ Chr(39)+';'+CRLF,[FldName]);
end;
end; {for arr1 to arr2}
end;
end;
end;
{$ELSE}
if RecList.Count > 0 then begin
For i:= 0 to RecList.Count-1 do begin
SStr:= RecList[i];
if (Pos(':',SStr) > 0) and (Pos('DUMMY',UpperCase(SStr)) = 0)
and (Pos('IGNORE',Uppercase(SStr)) = 0) then begin
G:= GetFieldTypEditor(SStr,FeldName,FieldDataType,Len,Arr1,Arr2,Decimals);
FieldName:= FeldName;
FldName:= FeldName;
For a:= Arr1 to Arr2 do begin
if Arr1 <> Arr2 then begin
Str(A,AStr);
FieldName:= FeldName+'['+AStr+']';
FldName:= FeldName + AStr;
end;
Case FieldDataType of
ftSmallInt,
ftBytes : FmtWrite(Result,
' %sInput.Text:= '+Chr(39)+'0'+Chr(39)+';'+ CRLF,[FldName]);
ftInteger,
ftWord,
ftDate : FmtWrite(Result,
' %sInput.Text:= '+Chr(39)+''+Chr(39)+';'+ CRLF,[FldName]);
ftFloat : FmtWrite(Result,
' %sInput.Text:= '+Chr(39)+'0.00'+Chr(39)+';'+ CRLF,[FldName]);
ftMemo : FmtWrite(Result,
' %sInput.Lines.Clear;'+ CRLF,[FldName]);
ftBoolean : FmtWrite(Result,
' %sInput.ItemIndex:= 0;'+CRLF,[FldName]);
else FmtWrite(Result,
' %sInput.Text:= '+Chr(39)+ Chr(39)+';'+CRLF,[FldName]);
end;
end; {for arr1 to arr2}
end;
end;
end;
{$ENDIF}
FmtWrite(Result,
' {AnlegBttn.Enabled:= True;}' + CRLF +
' {AendernBttn.Enabled:= False;}' + CRLF +
' {LoeschBttn.Enabled:= False;}' + CRLF +
'end;' + CRLF + CRLF, [NIL]);
FmtWrite(Result,
'procedure T%s.VorBttnClick(Sender: TObject);' + CRLF +
'var Txt1: String;'+CRLF+
'begin' + CRLF,[FormIdent]);
if Sprache = 1 then SStr:= 'Data not saved ? Proceed nevertheless ?'
else SStr:= 'Daten nicht gespeichert. Trotzdem weiter ?';
FmtWrite(Result,
' if (IsModified) then begin' + CRLF +
' if Sprache = 1 then Txt1:= '+Chr(39)+'Data not saved ? Proceed nevertheless ?'+Chr(39)+CRLF+
' else Txt1:= '+Chr(39)+'Daten nicht gespeichert. Trotzdem weiter ?'+Chr(39)+';'+CRLF+
' if JaNein(Txt1,'+Chr(39)+Chr(39)+') = False then Exit;' + CRLF,[NIL]);
FmtWrite(Result,
' end;' + CRLF +
' %sTable.Next(%sData,%sDup);' + CRLF +
' SetData;' + CRLF +
'end;' + CRLF + CRLF, [FormIdent,RecordName,RecordName]);
FmtWrite(Result,
'procedure T%s.RueckBttnClick(Sender: TObject);' + CRLF +
'var Txt1: String;'+CRLF+
'begin' + CRLF,[FormIdent]);
if Sprache = 1 then SStr:= 'Data not saved ? Proceed nevertheless ?'
else SStr:= 'Daten nicht gespeichert. Trotzdem weiter ?';
FmtWrite(Result,
' if (IsModified) then begin' + CRLF +
' if Sprache = 1 then Txt1:= '+Chr(39)+'Data not saved ? Proceed nevertheless ?'+Chr(39)+CRLF+
' else Txt1:= '+Chr(39)+'Daten nicht gespeichert. Trotzdem weiter ?'+Chr(39)+';'+CRLF+
' if JaNein(Txt1,'+Chr(39)+Chr(39)+') = False then Exit;' + CRLF,[NIL]);
FmtWrite(Result,
' end;' + CRLF +
' %sTable.Prior(%sData,%sDup);' + CRLF +
' SetData;' + CRLF +
'end;'+ CRLF + CRLF, [FormIdent,RecordName,RecordName]);
FmtWrite(Result,
'procedure T%s.NeuBttnClick(Sender: TObject);' + CRLF +
'var Txt1: String;'+CRLF+
'begin' + CRLF,[FormIdent]);
if Sprache = 1 then SStr:= 'Data not saved ? Proceed nevertheless ?'
else SStr:= 'Daten nicht gespeichert. Trotzdem weiter ?';
FmtWrite(Result,
' if (IsModified) then begin' + CRLF +
' if Sprache = 1 then Txt1:= '+Chr(39)+'Data not saved ? Proceed nevertheless ?'+Chr(39)+CRLF+
' else Txt1:= '+Chr(39)+'Daten nicht gespeichert. Trotzdem weiter ?'+Chr(39)+';'+CRLF+
' if JaNein(Txt1,'+Chr(39)+Chr(39)+') = False then Exit;' + CRLF,[NIL]);
FmtWrite(Result,
' end;' + CRLF +
' LeerData;' + CRLF +
'end;'+ CRLF + CRLF, [NIL]);
NStr:= 'ModalResult:= mrOK';
FmtWrite(Result,
'procedure T%s.OkBttnClick(Sender: TObject);' + CRLF +
'var Txt1: String;'+ CRLF +
'begin' + CRLF,[FormIdent]);
if Sprache = 1 then SStr:= 'Data not saved ? Proceed nevertheless ?'
else SStr:= 'Daten nicht gespeichert. Trotzdem weiter ?';
FmtWrite(Result,
' if IsModified then begin' + CRLF +
' if Sprache = 1 then Txt1:= '+Chr(39)+'Data not saved ? Proceed nevertheless ?'+Chr(39)+CRLF+
' else Txt1:= '+Chr(39)+'Daten nicht gespeichert. Trotzdem weiter ?'+Chr(39)+';'+CRLF+
' if JaNein(Txt1,'+Chr(39)+Chr(39)+') = False then Modalresult:= mrOk' + CRLF,[NIL]);
FmtWrite(Result,
' else Exit;' + CRLF +
' end' + CRLF +
' else %s;' + CRLF+
'end;'+ CRLF + CRLF, [NStr]);
NStr:= 'ModalResult:= mrCancel';
FmtWrite(Result,
'procedure T%s.AbbruchBttnClick(Sender: TObject);' + CRLF +
'begin' + CRLF,[FormIdent]);
FmtWrite(Result,
' OkBttnClick(Sender);' + CRLF +
'end;'+ CRLF + CRLF, [NStr]);
FmtWrite(Result,
'procedure T%s.AendernBttnClick(Sender: TObject);' + CRLF +
'var R: TRect;'+CRLF+
' Txt1,Txt2: String;'+CRLF+
'begin' + CRLF +
' GetData;' + CRLF +
' %sTable.UpdateRecord(%sData,%sDup);' + CRLF,
[FormIdent,FormIdent,RecordName,RecordName]);
if Sprache = 1 then SStr:= Chr(39)+'Record'+Chr(39)+','+Chr(39)+'updated'+Chr(39)
else SStr:= Chr(39)+'Datensatz'+Chr(39)+','+Chr(39)+'geΣndert'+Chr(39);
FmtWrite(Result,
' R:= Bounds(AendernBttn.Left+Self.Left-8,AendernBttn.Top+Self.top+50,32,32);'+CRLF+
' if Sprache = 1 then begin'+CRLF+
' Txt1:= '+Chr(39)+'Record'+Chr(39)+';'+CRLF+
' Txt2:= '+chr(39)+'updated'+Chr(39)+';'+CRLF+
' end'+CRLF,[NIL]);
FmtWrite(Result,
' else begin'+CRLF+
' Txt1:= '+chr(39)+'Datensatz'+Chr(39)+';'+CRLF+
' Txt2:= '+chr(39)+'geΣndert'+Chr(39)+';'+CRLF+
' end;'+CRLF,[NIL]);
FmtWrite(Result,
' ShowBubble(Self,R,800,Txt1,Txt2);'+CRLF+
' ResetModified;' + CRLF +
'end;' + CRLF + CRLF,[NIL]);
FmtWrite(Result,
'procedure T%s.AnlegBttnClick(Sender: TObject);' + CRLF +
'var R: TRect;'+CRLF+
' Txt1,Txt2: String;'+CRLF+
'begin' + CRLF +
' GetData;' + CRLF,[FormIdent]);
FmtWrite(Result,
' %sTable.Insert(%sData,%sDup);' + CRLF,
[FormIdent,RecordName,RecordName]);
if Sprache = 1 then SStr:= Chr(39)+'New Record'+Chr(39)+','+Chr(39)+'saved'+Chr(39)
else SStr:= Chr(39)+'Datensatz'+Chr(39)+','+Chr(39)+'angelegt'+Chr(39);
FmtWrite(Result,
' R:= Bounds(AnlegBttn.Left+Self.Left-8,AnlegBttn.Top+Self.top+50,32,32);'+CRLF+
' if Sprache = 1 then begin'+CRLF+
' Txt1:= '+Chr(39)+'New record'+Chr(39)+';'+CRLF+
' Txt2:= '+chr(39)+'saved'+Chr(39)+';'+CRLF+
' end'+CRLF,[NIL]);
FmtWrite(Result,
' else begin'+CRLF+
' Txt1:= '+chr(39)+'Datensatz'+Chr(39)+';'+CRLF+
' Txt2:= '+chr(39)+'angelegt'+Chr(39)+';'+CRLF+
' end;'+CRLF,[NIL]);
FmtWrite(Result,
' ShowBubble(Self,R,800,Txt1,Txt2);'+CRLF+
' ResetModified;' + CRLF +
'end;' + CRLF + CRLF,[NIL]);
FmtWrite(Result,
'procedure T%s.LoeschBttnClick(Sender: TObject);' + CRLF +
'var Key1,Txt1,Txt2: String;'+CRLF+
' R: TRect;'+CRLF+
'begin' + CRLF +
' GetData;' + CRLF,[FormIdent]);
FmtWrite(Result,
' Key1:= %sTable.Key_Proc(%sData,%sTable.KeyNo);'+CRLF+
' if Sprache = 1 then Txt1:= '+Chr(39)+'Delete '+Chr(39)+'+Key1+'+Chr(39)+' ?'+Chr(39)+CRLF+
' else Txt1:= '+Chr(39)+'Datensatz '+Chr(39)+'+Key1+'+Chr(39)+' l÷schen ?'+Chr(39)+';'+CRLF,
[FormIdent,RecordName,FormIdent]);
FmtWrite(Result,
' if Janein(Txt1,'+Chr(39)+Chr(39)+') then %sTable.Delete(%sData,%sDup);'+CRLF,
[FormIdent,RecordName,RecordName]);
if Sprache = 1 then SStr:= Chr(39)+'Record'+Chr(39)+','+Chr(39)+'deleted'+Chr(39)
else SStr:= Chr(39)+'Datensatz'+Chr(39)+','+Chr(39)+'gel÷scht'+Chr(39);
FmtWrite(Result,
' R:= Bounds(LoeschBttn.Left+Self.Left-8,LoeschBttn.Top+Self.top+50,32,32);'+CRLF+
' if Sprache = 1 then begin'+CRLF+
' Txt1:= '+Chr(39)+'Record'+Chr(39)+';'+CRLF+
' Txt2:= '+chr(39)+'deleted'+Chr(39)+';'+CRLF+
' end'+CRLF,[NIL]);
FmtWrite(Result,
' else begin'+CRLF+
' Txt1:= '+chr(39)+'Datensatz'+Chr(39)+';'+CRLF+
' Txt2:= '+chr(39)+'gel÷scht'+Chr(39)+';'+CRLF+
' end;'+CRLF,[NIL]);
FmtWrite(Result,
' ShowBubble(Self,R,800,Txt1,Txt2);'+CRLF+
' ResetModified;' + CRLF +
'end;'+ CRLF + CRLF, [NIL]);
FmtWrite(Result,
'procedure T%s.SuchBttnClick(Sender: TObject);' + CRLF +
'var Ref: Longint;'+CRLF+
' Key: IsamKeyStr;'+CRLF+
'begin' + CRLF,[FormIdent]);
FmtWrite(Result,
' if Such_Einstellen(%sTable,Self,%sData,%sDup,Ref,Key,KeyListe) then begin' + CRLF +
' SetData;' + CRLF,[FormIdent,RecordName,RecordName]);
FmtWrite(Result,
' end;'+CRLF+
'end;'+ CRLF + CRLF, [NIL]);
FmtWrite(Result,
'procedure T%s.KeyBttnClick(Sender: TObject);' + CRLF +
'var Key1: Integer;'+CRLF,[FormIdent]);
FmtWrite(Result,
'begin'+CRLF+
' Key1:= %sTable.KeyNo;'+CRLF,[Formident]);
FmtWrite(Result,
' Key_Einstellen(Self,Key1,KeyListe);'+CRLF+
' %sTable.KeyNo:= Key1;'+CRLF+
'end;'+ CRLF + CRLF, [FormIdent]);
FmtWrite(Result,
'procedure T%s.%sTimerTimer(Sender: TObject);'+ CRLF +
'var TStr: String;'+CRLF+
'begin'+ CRLF +
' TStr:= '+Chr(39)+Chr(39)+';'+CRLF,[FormIdent,FormIdent]);
FmtWrite(Result,
' DateTimeToString(TStr,'+Chr(39)+'dd.mm.yyyy hh:mm'+Chr(39)+',Now);'+CRLF+
' ZeitPanel.Caption:= TStr;' + CRLF +
'end;'+ CRLF + CRLF, [NIL]);
FmtWrite(Result,
'Procedure T%s.ShowHint(Sender: TObject);' + CRLF +
'begin' + CRLF +
' HintPanel.Caption:= Application.Hint;' + CRLF +
'end;' + CRLF + CRLF,[FormIdent]);
FmtWrite(Result,
'Procedure T%s.FormKeyPress(Sender: TObject; var Key: Char);'+CRLF+
'begin'+CRLF+
' if Key = #13 then begin'+CRLF+
' if not(ActiveControl is TMemo) then begin'+CRLF,[FormIdent]);
FmtWrite(Result,
' Key := #0;'+CRLF+
' Perform(WM_NEXTDLGCTL, 0, 0);'+CRLF+
' end;'+CRLF+
' end;'+CRLF+
'end;'+CRLF+CRLF,[NIL]);
FmtWrite(Result, 'end.' + CRLF, [nil]);
Result.Position := 0;
except
Result.Free;
raise;
end;
finally
StrDispose(SourceBuffer);
end;
end;
end.